perm filename SUNSER.MID[S,NET]5 blob
sn#820015 filedate 1986-06-27 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE SUNSER
C00005 00003 TERMID CORBEG TERSTR NETCMP RCBINP TRBINP ECHOP SUPGAP FLSCHP PUPIBH PUPOBH GOTINT PDL COREND RFCBLK SUNSKT SUNHST SMRBLK RMRBLK INPBLK
C00008 00004 TPLTAB TPLMIN WDOTAB WDOMAX EXOPL
C00011 00005 SUNSER
C00013 00006 CPYHST 1DIGTP NOTTIP
C00015 00007 GETHSN BADHST GETSKT GETSKN BADSKT
C00017 00008 PUPICP
C00019 00009 NETSER NETSR1
C00021 00010 PUPSER PUPSR1 PUPSR2 PUPSR3
C00024 00011 IACSER PRSTAB WHOLIN
C00026 00012 DOSR DONTSR
C00028 00013 WILLSR WONTSR
C00029 00014 OPTMSG RNDMSG SNDMSG MSGLUP SUICID DEATH ...LIT SVRRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
C00031 ENDMK
C⊗;
TITLE SUNSER
SUBTTL Mark Crispin, SU-AI, October 1981
; Assembly switches
IFNDEF SVRSKT,SVRSKT==89. ; default listen socket
IFNDEF CHTSKT,CHTSKT==1 ; default Chat socket
IFNDEF LOKTMO,LOKTMO==5 ; # of 15-second frobs of lock timeout
IFNDEF PDLLEN,PDLLEN==50 ; stack length
; AC definitions. 0→3 are used by NETWRK
X=4 ? A=5 ? B=6 ? C=7 ? P=17
PUP==2 ; Pup's I/O channel (NETWRK uses 0 and 1)
; Macro to send a TELNET command
DEFINE TELCMD CMDLST
OUTSTR [ASCIZ/⊗!CMDLST!*
/]
IRPS CMD,,CMDLST
MOVEI CMD
PUSHJ P,NETOCH
TERMIN
PUSHJ P,NETSND
TERMIN
; SAIL system bit definitions
INTCLK==000200,, ; clock interrupt
INTIMS==000020,, ; status change interrupt
INTINP==000010,, ; input interrupt
IODTER==100000 ; timeout
IOBKTL==040000 ; block too large
IODEND==020000 ; End seen
INTBTS==INTCLK\INTINP\INTIMS
;TERMID CORBEG TERSTR NETCMP RCBINP TRBINP ECHOP SUPGAP FLSCHP PUPIBH PUPOBH GOTINT PDL COREND RFCBLK SUNSKT SUNHST SMRBLK RMRBLK INPBLK
; Terminal location string
TERMID: 'TERMID
CORBEG==. ; start of initialized core storage
TERSTR: BLOCK 40 ; console location string
; Protocol flags
NETCMP: BLOCK 1 ; -1 → IAC in progress
IRPS OPT,,WILL WONT DO DONT
OPT!P: BLOCK 1 ; -1 → option in effect
TERMIN
RCBINP: BLOCK 1 ; -1 → receiving binary
TRBINP: BLOCK 1 ; -1 → transmitting binary
ECHOP: BLOCK 1 ; -1 → remote echoing
SUPGAP: BLOCK 1 ; -1 → suppressing GA
FLSCHP: BLOCK 1 ; -1 → flush next character
; Other storage
PUPIBH: BLOCK 3 ; Pup input buffer header
PUPOBH: BLOCK 3 ; Pup output buffer header
GOTINT: BLOCK 1 ; -1 → got an interrupt
PDL: BLOCK PDLLEN ; stack
COREND==.-1 ; end of initialized storage
RFCBLK: 0 ; connect to remote host
0 ; status word
0 ; socket number (1 for TELNET)
-1 ; wait flag
8 ; byte size
SUNSKT: 1 ; foreign socket number
SUNHST: 0 ; host
SMRBLK: 25 ; send Mark
0 ; status word
6 ; Timing Mark Reply
RMRBLK: 26 ; read last Mark
0 ; status word
0 ; Mark type returned here
INPBLK: 10 ; skip if input available
0 ; status word
;TPLTAB TPLMIN WDOTAB WDOMAX EXOPL
DEFINE TPC CODE
CODE
IRPS NAME,,CODE
[ASCIZ/NAME/]
.ISTOP
TERMIN
TERMIN
; Protocol codes
TPLTAB:
TPC SE==360 ; subnegotiation end
TPC NOP==361 ; no-op
TPC DM==362 ; data mark
TPC BRK==363 ; break key
TPC IP==364 ; interrupt process
TPC AO==365 ; abort output
TPC AYT==366 ; are you there?
TPC EC==367 ; erase character
TPC EL==370 ; erase line
TPC GA==371 ; go ahead
TPC SB==372 ; subnegotiation
TPC WILL==373 ; sender will do
TPC WONT==374 ; sender won't do
TPC DO==375 ; receiver asked to do
TPC DONT==376 ; receiver must not do
TPC IAC==377 ; interpret as command
TPLMIN==400-<.-TPLTAB>
; WILL/WONT/DO/DONT codes
WDOTAB:
TPC TRNBIN==0 ; transmit binary
TPC ECHO==1 ; echo
TPC RCP==2 ; reconnect
TPC SUPRGA==3 ; suppress GA
TPC NAMS==4 ; negotiate approx. message size
TPC STATUS==5 ; status option
TPC TIMMRK==6 ; timing mark
TPC RCTE==7 ; remote controlled trans/echo
TPC NAOL==10 ; negotiate output line width
TPC NAOP==11 ; negotiate page size
TPC NAOCRD==12 ; negotiate output CR
TPC NAOHTS==13 ; negotiate output horizontal tab stops
TPC NAOHTD==14 ; negotiate output HT
TPC NAOFFD==15 ; negotiate output FF
TPC NAOVTS==16 ; negotiate output vertical tab stops
TPC NAOVTD==17 ; negotiate output VT
TPC NAOLFD==20 ; negotiate output LF
TPC EXTASC==21 ; Tovar's cretinous idea of extended ASCII
TPC LOGOUT==22 ; logout option
TPC BM==23 ; byte macro
TPC DET==24 ; data entry terminal option
TPC SUPDUP==25 ; SUPDUP (not TELNET) protocol
TPC SDOTPT==26 ; SUPDUP output option
WDOMAX==.-WDOTAB-1
EXOPL==377 ; extended options (great idea Postel)
;SUNSER
SUNSER: TRN
RESET
MOVE ['SUNSER] ; set our name
SETNAM
SETZM CORBEG ; initialize core
MOVE [CORBEG,,CORBEG+1]
BLT COREND
MOVE P,[PDL(-PDLLEN)]
MOVEI [DEBREAK ? EXIT]
MOVEM JOBAPR
CLKINT 5.*60.*60. ; must die if around too long
OUTSTR [ASCIZ/SUNSER started
/]
MOVEI SVRSKT ; listen for connection
MOVEM LSNSKT
PUSHJ P,LISTEN
MOVEI [ SETOM GOTINT ; flag an interrupt
MOVE X,JOBCNI
TLNE X,(INTINR)
OUTSTR [ASCIZ/*INR*
/]
TLNE X,(INTINS) ; INS int
OUTSTR [ASCIZ/*INS*
/]
MOVSI 1,-1 ; requeue into TQ from any queue
DISMIS 1,]
MOVEM JOBAPR ; set up server location
CLKINT 60.*15. ; start slow ticking clock
MOVSI (INTBTS)
INTENB ; turn on interrupts
MOVEI TERMID
MOVEM JOBVER
;falls through
;CPYHST 1DIGTP NOTTIP
; drops in
OUTSTR [ASCIZ/Connected to /]
PUSHJ P,MAPHST ; map in host table
MOVE HOST
PUSHJ P,HSTNUM ; get HDB
TRN ; sorry about errors
MOVEI A,(1) ; host name
HRLI A,440700
SKIPA X,[440700,,TERSTR]
CPYHST: IDPB B,X
ILDB B,A
JUMPN B,CPYHST
HLRZ A,1 ; pointer to system name
MOVE B,(A) ; get system name
MOVE A,FSOCKT ; and ICP socket
CAMN B,[ASCII/TIP/] ; on a TIP?
TRNE A,177774 ; just paranoia; make sure a TIP port
JRST NOTTIP
MOVEI B,"#
IDPB B,X
LSH A,-16.
IDIVI A,8. ; ports are octal
JUMPE A,1DIGTP
ADDI A,"0 ? IDPB A,X
1DIGTP: ADDI B,"0 ? IDPB B,X
NOTTIP: PUSHJ P,SETANM ; set our alias name
PUSHJ P,UNMHST ; map out the host table
OUTSTR TERSTR
OUTSTR [ASCIZ/
/]
; Initialize the Pup channel
INIT PUP,
SIXBIT/PUP/
PUPOBH,,PUPIBH
JRST [MOVEI X,[ASCIZ/The gateway is down
/]
PUSHJ P,SNDMSG
JRST SUICID]
MOVEI X,[ASCIZ/SU-AI ARPANET => SUnet Gateway Version 1.0
/]
PUSHJ P,SNDMSG
;GETHSN BADHST GETSKT GETSKN BADSKT
; Get host number
SETZB A,B ; clear host number register
MOVEI C,CHTSKT ; initialize socket number
GETHSN: PUSHJ P,NETICW ; get a digit
CAIN ". ; socket delimiter?
JRST GETSKT
CAIN ↑M ; return is alternate terminator
PUSHJ P,NETICW
JUMPE PUPICP ; allow null and LF for convenience
CAIE ↑J
CAIN <" > ; terminator?
JRST PUPICP ; yes, try to open connection
CAIL "0 ; numeric?
CAILE "7
JRST BADHST
LSH A,3 ; add new number in
SUBI "0
ADD A,
CAIG A,177777 ; host number is losing if greater than this
JRST GETHSN
BADHST: MOVEI X,[ASCIZ/-Invalid host number
/]
PUSHJ P,SNDMSG
JRST SUICID
GETSKT: SETZ C, ; don't use default any more
GETSKN: PUSHJ P,NETICW ; get a socket digit
CAIN ↑M ; return is alternate terminator
PUSHJ P,NETICW
JUMPE PUPICP ; allow null and LF for convenience
CAIE ↑J
CAIN <" > ; terminator?
JRST PUPICP ; yes, try to open connection
CAIL "0 ; numeric?
CAILE "7
JRST BADSKT
LSH C,3 ; add new number in
SUBI "0
ADD C,
CAIG C,777 ; socket number is losing if greater than this
JRST GETSKN
BADSKT: MOVEI X,[ASCIZ/-Invalid socket number
/]
PUSHJ P,SNDMSG
JRST SUICID
;PUPICP
PUPICP: MOVEM A,SUNHST ; set host number
MOVEM C,SUNSKT ; set socket number
MOVEI 8. ; change byte size in buffer header
DPB [300600,,PUPIBH+1]
DPB [300600,,PUPOBH+1]
INBUF PUP,
OUTBUF PUP,
MTAPE PUP,RFCBLK ; open up the conection
MOVE RFCBLK+1 ; check for MTAPE error
STATO PUP,467600
TRNE 77
JRST [ MOVEI X,[ASCIZ/-Host dead
/]
PUSHJ P,SNDMSG
JRST SUICID]
MOVEI X,[ASCIZ/+/]
PUSHJ P,SNDMSG
; Send ARPANET protocol commands
TELCMD [IAC WILL ECHO IAC WILL SUPRGA]
SETOM ECHOP ? SETOM SUPGAP
LOCK ; lock us in core
; Main program loop
LOOP: SKIPN GOTINT ; got an interrupt?
IMSTW [INTBTS] ; wait for one to happen
INTMSK [0] ; mask off interrupts
SETZM GOTINT
MOVEI 2 ; check connection status
MTAPE NET,
TLNN 1,(CLSS\CLSR) ; send side gronked?
TLNE 2,(CLSS\CLSR) ; receive side?
JRST SUICID
; JRST NETSER
;NETSER NETSR1
; ARPANET server
NETSER: PUSHJ P,NETICH ; get character from ARPANET
JRST PUPSER ; ARPANET input buffer empty
AOSG NETCMP ; IAC in progress?
JRST IACSER
IRPS OPT,,WILL WONT DO DONT
AOSG OPT!P
JRST OPT!SR
TERMIN
CAIN IAC ; network command?
JRST [ SETOM NETCMP ; remember that one is coming
JRST NETSER]
NETSR1: SKIPE RCBINP
JRST NETSR2
AOSN FLSCHP ; flush this character?
JRST NETSER
CAIN ↑M ; CR?
SETOM FLSCHP ; yes, flush next character
NETSR2: SOSG PUPOBH+2 ; space in buffer?
OUTPUT PUP, ; no, output the byte
IDPB PUPOBH+1 ; stuff the character in the buffer
JRST NETSER ; try for more user characters
;PUPSER PUPSR1 PUPSR2 PUPSR3
; Pup server
PUPSER: MOVE A,PUPOBH+2 ; set fill bits and force the buffer out
ANDI A,3
MOVE A,[0
1
3
7](A)
SKIPLE PUPOBH ; set fill bits only if buffers are setup properly
DPB A,[ 000420,,PUPOBH+1]
; POINT 4,@PUPOBH+1,35 ; Sigh... This can't be in a literal???
OUTPUT PUP,
PUPSR1: SOSLE PUPIBH+2 ; data available?
JRST PUPSR4
HRRZ 1,PUPIBH
HRRZ 1,(1)
SKIPGE (1) ; anything in further buffers?
JRST PUPSR2
MTAPE PUP,INPBLK ; no - new packet available?
JRST [ PUSHJ P,NETSND ; send the buffer out
STATZ PUP,IODEND
JRST SUICID
JRST LOOP]
PUPSR2: IN PUP, ; yes - get it
JRST PUPSR3
GETSTS PUP,1
IFNDEF TMO,TMO==0 ;no such bit under IP/TCP
TRNE 1,IODEND\IODTER\IODERR\TMO ; End or error seen?
JRST SUICID
TRZN 1,IOBKTL ; Mark seen?
JRST 4,.-1
SETSTS PUP,(1) ; yes, clear error status
MTAPE PUP,RMRBLK
TRN
MOVE RMRBLK+2 ; get Mark type
CAIE 5 ; Timing Mark?
JRST PUPSR1 ; something random
MTAPE PUP,SMRBLK ; yes, send Timing Mark Reply
JRST SUICID
JRST PUPSR1
PUPSR3: MOVE A,PUPIBH ; get buffer header
ADD A,1(A) ; find last word in buffer
MOVE A,1(A) ; get that word
ANDI A,7 ; look at low order bits (faster than LDB)
TRNE A,4
SKIPA A,[4] ; 7 means 4-1 unused bytes
TRNE A,2 ; 3 means 3-1 unused bytes
SUBI A,1
MOVN A,A
ADDM A,PUPIBH+2 ; update count to account for fill bytes
PUPSR4: ILDB PUPIBH+1 ; get the byte
PUSHJ P,NETOCH ; send it to the network
JRST PUPSR1
;IACSER PRSTAB WHOLIN
; IAC server
IACSER: OUTSTR [ASCIZ/*IAC /]
CAIGE TPLMIN ; big enough?
JRST [ PUSHJ P,RNDMSG ; unknown, flush
JRST NETSER]
MOVE 1,
OUTSTR @TPLTAB-TPLMIN(1)
CAIE IAC
CAIGE WILL
OUTSTR [ASCIZ/*
/]
XCT PRSTAB-TPLMIN(1)
JRST NETSER
DEFINE NC CODE,SERVER
IFN .+TPLMIN-PRSTAB-CODE,.ERR Lossage at CODE
SERVER
TERMIN
PRSTAB: ; Protocol command server table
NC SE,[JRST NETSER]
NC NOP,[JRST NETSER]
NC DM,[JRST NETSER]
NC BRK,[JRST NETSER]
NC IP,[JRST NETSER]
NC AO,[JRST NETSER]
NC AYT,[JRST WHOLIN]
NC EC,[JRST NETSER]
NC EL,[JRST NETSER]
NC GA,[JRST NETSER]
NC SB,[JRST NETSER]
NC WILL,[SETOM WILLP]
NC WONT,[SETOM WONTP]
NC DO,[SETOM DOP]
NC DONT,[SETOM DONTP]
NC IAC,[JRST NETSR1]
; IAC AYT
WHOLIN: MOVEI X,[ASCIZ/SU-AI ARPANET => SU-NET Gateway is alive
/]
PUSHJ P,SNDMSG
JRST NETSER
;DOSR DONTSR
; IAC DO/DONT
DOSR: PUSHJ P,OPTMSG
CAIN TRNBIN ; binary from host
JRST [ SKIPE TRBINP ; catch protocol loops
JRST NETSER
SETOM TRBINP
TELCMD [IAC WILL TRNBIN]
JRST NETSER]
CAIN ECHO ; remote echo (what a win!)
JRST [ SKIPE ECHOP ; catch protocol loops
JRST NETSER
SETOM ECHOP
TELCMD [IAC WILL ECHO]
JRST NETSER] ; command, we always accept it
CAIN SUPRGA ; suppress GA?
JRST [ SKIPE SUPGAP ; command or reply?
JRST NETSER
SETOM SUPGAP
TELCMD [IAC WILL SUPRGA]
JRST NETSER]
; Not an option we like, refuse it
PUSH P,
OUTSTR [ASCIZ/⊗IAC WONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI WONT
PUSHJ P,NETOCH
POP P,
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NETSER
DONTSR: PUSHJ P,OPTMSG
CAIN TRNBIN
JRST [ SKIPN TRBINP
JRST NETSER
SETZM TRBINP
TELCMD [IAC WONT TRNBIN]
JRST NETSER]
CAIN ECHO
JRST [ SKIPN ECHOP
JRST NETSER
SETZM ECHOP ; back to lossage
TELCMD [IAC WONT ECHO]
JRST NETSER]
CAIN SUPRGA
SKIPL SUPGAP
JRST NETSER ; protocol violator
SETZM SUPGAP
TELCMD [IAC WONT SUPRGA]
JRST NETSER ; loser
;WILLSR WONTSR
; IAC WILL/WONT
WILLSR: PUSHJ P,OPTMSG
CAIN TRNBIN ; binary to host
JRST [ SKIPE RCBINP ; catch protocol loops
JRST NETSER
SETOM RCBINP
TELCMD [IAC DO TRNBIN]
JRST NETSER]
; Not an option we like, refuse it
PUSH P,
OUTSTR [ASCIZ/⊗IAC DONT/]
MOVEI IAC
PUSHJ P,NETOCH
MOVEI DONT
PUSHJ P,NETOCH
POP P,
PUSHJ P,OPTMSG
PUSHJ P,NETOCH
PUSHJ P,NETSND
JRST NETSER
WONTSR: PUSHJ P,OPTMSG
CAIN TRNBIN
SKIPN RCBINP
JRST NETSER
SETZM RCBINP
TELCMD [IAC DONT TRNBIN]
JRST NETSER
;OPTMSG RNDMSG SNDMSG MSGLUP SUICID DEATH ...LIT SVRRTS ERRTNS ERRHAN ERRINS HSTTAB HSTSIX
; Subroutines
; WILL/WONT/DO/DONT option message
OPTMSG: CAIN EXOPL
JRST [ OUTSTR [ASCIZ/ EXOPL*
/]
POPJ P,]
OUTCHR [" ]
CAILE WDOMAX
JRST RNDMSG
MOVE 1,
OUTSTR @WDOTAB(1)
OUTSTR [ASCIZ/*
/]
POPJ P,
RNDMSG: IDIVI 100 ; output the octal for an unknown message
ADDI "0
OUTCHR
IDIVI 10
ADDI 1,"0
OUTCHR 1
ADDI 2,"0
OUTCHR 2
OUTSTR [ASCIZ/*
/]
POPJ P,
; Send a message, b.p. in X
SNDMSG: TLOA X,440700 ; set up b.p.
MSGLUP: PUSHJ P,NETOCH
ILDB X
JUMPN MSGLUP ; continue until a null hit
JRST NETSND
; Here to suicide on network errors or idle timeout
SUICID: PUSHJ P,CLOSER
DEATH: RESET
EXIT
...LIT: CONSTANTS
; Wonderful network routines
SVRRTS==-1 ; include server routines
ERRTNS==-1 ; include error routines
ERRHAN==-1 ; include automagic error handling
ERRINS==<JRST DEATH> ; error instruction
HSTTAB==-1 ; include host table magic
HSTSIX==-1 ; and alias name kludge
.INSRT NETWRK
END SUNSER